perm filename MKBITS[2,BGB] blob
sn#038130 filedate 1973-07-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE MKBITS
C00006 00003 NSUBR MKBITS,LVL
C00008 00004 NSUBR MKPEAK,LVL
C00012 00005 NSUBR MKSEGS
C00016 00006 ----- MKSEGS: ADD TO SEGMENT RING
C00018 00007 ----- MKSEGS: SEGMENT FISSION
C00021 00008 NSUBR FILL
C00023 00009 NSUBR KLSEGS
C00027 00010 NSUBR LTXING,SEGMENT
C00030 00011 NSUBR RTXING,SEGMENT
C00033 00012 NSUBR KLSEG,SEG
C00034 00013 NSUBR KLPEAK,PEAK
C00035 00014 NSUBR FUSION,SEG1,SEG2
C00036 00015 SUBRS ZAPTIM,CLRPAK,REVHOL,RSTHOL
C00039 00016 SUBRS CENPIC,RECPIC
C00041 ENDMK
C⊗;
TITLE MKBITS
;(ARC OF VERTEX → SEGMENT)
;0 CW CCW SCAN LINE RING
;1 ? ?
;2 TYPE 300003
;3 LDEL RDEL ;LEFT AND RIGHT DELTA COLUMN
;4 LCOL RCOL ;LEFT AND RIGHT COLUMN NUMBER
;5 LROW RROW ;LEFT AND RIGHT ROW OF TERMINATION
;6 LT RT ;LEFT AND RIGHT TERMINAL VECTORS
SEGREL←300003
;segment node - defn: a segment is a portion of a scan line.
; DEFINE LDEL(A,Q){HLRZ A,3(Q)}↔DEFINE LDEL.(A,Q){HRLM A,3(Q)}
; DEFINE RDEL(A,Q){HRRZ A,3(Q)}↔DEFINE RDEL.(A,Q){HRRM A,3(Q)}
DEFINE LDEL(A,Q){HLRE A,3(Q)}↔DEFINE LDEL.(A,Q){HRLM A,3(Q)}
DEFINE RDEL(A,Q){HRRE A,3(Q)}↔DEFINE RDEL.(A,Q){HRRM A,3(Q)}
DEFINE LCOL(A,Q){HLRE A,4(Q)}↔DEFINE LCOL.(A,Q){HRLM A,4(Q)}
DEFINE RCOL(A,Q){HRRE A,4(Q)}↔DEFINE RCOL.(A,Q){HRRM A,4(Q)}
DEFINE LROW(A,Q){HLRE A,5(Q)}↔DEFINE LROW.(A,Q){HRLM A,5(Q)}
DEFINE RROW(A,Q){HRRE A,5(Q)}↔DEFINE RROW.(A,Q){HRRM A,5(Q)}
DEFINE LT (A,Q){HLRZ A,6(Q)}↔DEFINE LT. (A,Q){HRLM A,6(Q)}
DEFINE RT (A,Q){HRRZ A,6(Q)}↔DEFINE RT. (A,Q){HRRM A,6(Q)}
DEFINE LSEG(A,Q){HLRZ A,6(Q)}↔DEFINE LSEG.(A,Q){HRLM A,6(Q)}
DEFINE RSEG(A,Q){HRRZ A,6(Q)}↔DEFINE RSEG.(A,Q){HRRM A,6(Q)}
DEFINE PKCW(A,Q){HLRZ A,6(Q)}↔DEFINE PKCW.(A,Q){HRLM A,6(Q)}
DEFINE PKCCW(A,Q){HRRZ A,6(Q)}↔DEFINE PKCCW.(A,Q){HRRM A,6(Q)}
;VARIABLES GLOBAL TO THE SUBROUTINES IN THIS FILE.
PEAK0: 0 ;ORDERED RING OF PEAK VERTICES.
SEG0: 0 ;ORDERED RING OF SEGMENTS.
ROW0: 0 ;CURRENT SCAN LINE ROW POSITION.
ROWM1: 0 ;PREVIOUS SCAN LINE ROW POSITION.
DEBUG: 0
PAKBIT: 0 ;BIT FOR REGION PACKING.
PAK: 0 ;PICTURE ACCUMULATOR 216 ROWS OF 288 BITS/ROW.
BLOCK =1728
PAKEND←←.-1
PAKPTR: ;PAK COLUMN BIT ADDRESS VECTOR.
RADIX 12
FOR I←0,7{
FOR J←0,=35{POINT 1,PAK+I(2),J
}}↔RADIX 8
DECLARE{RMIN,RMAX,CMIN,CMAX}
INTERNAL RMIN,RMAX,CMIN,CMAX,DEBUG,ROW0,ROWM1,PAK,PAKPTR,PAKEND
EXTERNAL MAKE,KILL,DPYSGS,LIMITS,CNTFLG,XYMOVE
↓REVBIT←←1B2
WARNMSG: ASCIZ/WARNING - /
NSUBR MKBITS,LVL
CALL(ZAPTIM,LVL) ;CLEAR PTIME AND NTIME POINTERS
CALL(REVHOL,LVL) ;REVERSE HOLES
CALL(CENPIC,LVL) ;CENTER WRT PIXELS
L0: CALL(CLRPAK) ;CLEAR PAK ARRAY
CALL(MKPEAK,LVL) ;MAKE RING OF PEAKS
SETZM SEG0 ;FLUSH OLD SEGMENT IF WE BLEW UP LAST
;TIME (THIS LEAVES GARBAGE AROUND).
SKIPN 1,PEAK0 ;IS THERE ANYTHING TO DO?
GO FIN ;NO, RETURN
ROW 1,1 ;GET FIRST ROW TO LOOK AT
SKIPGE 1
OUTSTR[ASCIZ/WARNING: THIS GLYPH IS OFF-SCREEN, PLEASE MOVE DOWN.
/]
ANDCMI 1,77 ;USE PIXEL BOUNDARY
MOVEM 1,ROW0
SUBI 1,ROW0
MOVEM 1,ROWM1
SETOM PAKBIT
LOOP: CALL(MKSEGS) ;ADD ANY SEGMENT BEGINNING AT THIS SCAN LINE
CALL(FILL) ;PUT BITS INTO PAK
SKIPE DEBUG ;LET'S WATCH IT!
GO [ CALL(DPYSGS,SEG0)
GO .+1]
MOVEI 1,100 ;INCREMENT SCAN LINE
ADD 1,ROW0
EXCH 1,ROW0
MOVEM 1,ROWM1
CALL(KLSEGS) ;ADVANCE SEGMENT, DELETING ONES WHICH TERMINATE
GO LOOP ;NON-SKIP RETURN MEANS MORE TO COME
FIN: CALL(RECPIC,LVL) ;RESET PIXEL CENTERING
CALL(RSTHOL,LVL) ;RESTORE ORDER IN HOLES
POP1J
SUBREND MKBITS
NSUBR MKPEAK,LVL
;Make a ring of peaks. A peak is a vertex where the rows of the
;adjacent vertices are below it. In this data structure, this
;means: ROW(CW(PEAK))<ROW(PEAK)∧ROW(CCW(PEAK))≤ROW(PEAK).
;
ACCUMULATORS{C,RL,R,RN,V,VN,V0,PGN,PGN0}
MOVE 1,LVL
SON PGN,1 ;GET FIRST POLYGON
JUMPE PGN,POP1J.
MOVEM PGN,PGN0 ;REMEMBER FOR TERMINATION
SETZM PEAK0 ;CLEAR OLD RING
PLOOP: SON V,PGN ;GET FIRST VERTEX
JUMPE V,PCONT
MOVEM V,V0 ;REMEMBER FOR TERMINATION
CCW VN,V ;INIT. VERTICES
ROW R,V ;AND ROWS
ROW RN,VN
GO VENTRY ;FIRST VERTEX ALWAYS A PEAK
VLOOP: MOVE V,VN ;ADVANCE TO NEXT VERTEX
CCW VN,VN
CAMN V,V0 ;DONE WITH THE POLYGON?
GO [PCONT:
CCW PGN,PGN ;YES, GET NEXT POLYGON
CAME PGN,PGN0 ;DONE WITH THE LEVEL
GO PLOOP ;NO, DO ANOTHER POLYGON
POP1J ] ;YES, RETURN
MOVE RL,R ;DON'T FORGET TO ADVANCE ROWS TOO
MOVE R,RN
ROW RN,VN
CAMLE RN,R ;IS NEXT LOWER OR AT LEAST EQUAL?
CAMGE RL,R ;AND IS LAST VERTEX LOWER?
GO VLOOP ;NO, TRY NEXT VERTEX
VENTRY: MARK V,TMPBIT ;USE TMPBIT FOR PEAKS
SKIPN 1,PEAK0 ;WE FOUND A PEAK, IS THERE A PEAK RING?
GO [ PKCW. V,V ;NO, MAKE ONE
PKCCW. V,V
MOVEM V,PEAK0
GO SETTYP ] ;NOW LOOK FOR MORE PEAKS
COL C,V ;GET COLUMN IN CASE WE NEED IT
PKLOOP: ROW 0,1 ;GET ROW OF PEAK
CAMGE 0,R ;IS IT LARGE THE NEW PEAK?
GO [ NEXTPK: PKCCW 1,1 ;NO, TRY NEXT ONE?
CAME 1,PEAK0 ;WAS THAT THE LAST
GO PKLOOP ;NO, THEN TRY IT
GO PKLAST ] ;YES, INSERT AFTER LAST PEAK
CAMN 0,R ;IS IT THE SAME HEIGHT AS PEAK?
GO [ COL 0,1 ;YES, THEN CHECK COLUMN
CAMGE 0,C ;IS IT LEFT OF NEW PEAK?
GO NEXTPK ;YES, TRY NEXT ONE
GO .+1 ] ;NO, INSERT IT HERE
CAMN 1,PEAK0 ;IS IT BEFORE FIRST PEAK?
MOVEM V,PEAK0 ;YES, IT WILL BECOME FIRST PEAK
PKLAST: PKCW C,1 ;GET PREVIOUS TO DO INSERTION
PKCCW. 1,V ;MAKE INSERTION INTO DOUBLY LINKED LIST
PKCCW. V,C
PKCW. C,V
PKCW. V,1
SETTYP: MOVEI 3
DPB 0,[POINT 2,2(V),35] ;CHANGE RELOCATION TO INDICATE PEAK RING!
GO VLOOP ;NOW, LOOK FOR MORE PEAKS
SUBREND MKPEAK
NSUBR MKSEGS
;Check ordered list of peaks and if top peak is to be activated this
;scan line, kill it and make a segment out of it. If the segment is
;backwards, then it is a hole and a segment must be found for it to
;break. Otherwise, it is added to the ordered list of segments.
;
ACCUMULATORS{T1,T2,T3,T4,L,R,PK,SEG}
SKIPN PK,PEAK0 ;ANYTHING TO LOOK AT?
POP0J ;NO, RETURN QUICKLY
ROW R,PK ;TIME TO CREATE NEW SEGMENT YET?
CAMLE R,ROW0
POP0J ;NO, RETURN
CALL(KLPEAK,PK) ;KILL THE PEAK
SETQ SEG,{MAKE,[ARCBIT+EBIT+SEGREL]} ;AND MAKE A SEGMENT
SETZM (SEG) ;(SHORT FOR POINTING TO SELF)
LT. PK,SEG ;LINK LEFT TERMINATOR
LSEG. SEG,PK
CALL(LTXING,SEG) ;FIND REAL LEFT TERMINATOR
GO [ AOS LT001 ;FOR DEBUGGING
EXCH 1,SEG ;CHEAP FUSION
CALL(KILL,1)
SETZ 0,
RT 1,SEG ;FLUSH OLDE SEGMENT LINK
RSEG. 0,1
RT. PK,SEG ;LINK NEW RIGHT TERMINATOR
RSEG. SEG,PK
CALL(RTXING,SEG) ;DON'T FORGET THE LEFT TERMINATOR!
GO [ AOS LT004 ;FOR DEBUGGING
CALL(FUSION,SEG,1) ;NOT AGAIN!!
GO MKSEGS ]
JFCL ;NO R.T., NEVERMIND, USE OLD R.T.
GO MKSEGS ] ;LOOK FOR MORE
GO [ AOS LT002 ;FOR DEBUGGING
CALL(KLSEG,SEG) ;KILL BABY SEGMENT
GO MKSEGS ] ;BACK FOR MORE
AOS LT003
RT. PK,SEG ;LINK RIGHT TERMINATOR
RSEG. SEG,PK
CALL(RTXING,SEG) ;FIND REAL RIGHT TERMINATOR
GO [ AOS RT001 ;FOR DEBUGGING
CALL(FUSION,SEG,1) ;SEGMENT FOUND, COMBINE
GO MKSEGS ] ;LOOK FOR MORE
GO [ AOS RT002 ;FOR DEBUGGING
OUTSTR WARNMSG
OUTSTR [ ASCIZ/UNEXPECTED SEGMENT DEATH - MKSEGS
/]↔ CALL(KLSEG,SEG) ;KILL RANDOM SEGMENT
GO MKSEGS ] ;BACK FOR MORE
AOS RT003
RCOL R,SEG ;GET COLUMNS FOR INSERTING INTO SEGMENT RING
LCOL L,SEG
CAMG R,L ;FISSION?
GO [ CAME R,L ;CAN WE TELL YET?
GO FISSION ;YES, A FISSION HOLE
AOS EQ001 ;FOR DEBUGGIONG
RT 1,SEG ;NO, CHECK DELTAS
COL 0,1
LT 1,SEG
COL 1,1
CAMGE 0,1 ;FISSION?
GO FISSION ;YES
GO .+1 ]
;FALL THRU TO NEXT PAGE
;----- MKSEGS: ADD TO SEGMENT RING
;
SKIPN 1,SEG0
GO [ MOVEM SEG,SEG0 ;NO SEGMENT RING, MAKE ONE
CW. SEG,SEG
CCW. SEG,SEG
GO MKSEGS ] ;DO NEXT PEAK
ADLOOP: LCOL 0,1 ;INSERT IN FROM OF THIS PEAK?
CAMGE 0,L
GO [ CCW 1,1 ;NO, TRY NEXT
CAME 1,SEG0 ;IS THERE ONE?
GO ADLOOP ;YES
GO ADLAST ] ;NO, ADD AT END
ADDSEG: CAMN 1,SEG0 ;BEFORE FIRST?
MOVEM SEG,SEG0 ;NEW FIRST SEGMENT
ADLAST: CW L,1 ;GET LAST SEGMENT FOR INSERTION
CCW. 1,SEG ;USUAL INSERTION INTO DOUBLY LINKED LIST
CCW. SEG,L
CW. L,SEG
CW. SEG,1
GO MKSEGS ;NOW, LOOK AT NEXT PEAK
;----- MKSEGS: SEGMENT FISSION
; _____________________________________
; L SEG2 __________ R
; R SEG1 L
;
;
; _________________ __________
; L SEG1 R L SEG2 R
;
;Fission is accomplished by locating the surrounding segment (SEG2)
;and swapping left terminators with new segment (SEG1).
;
FISSION: AOS FS001
SKIPN 1,SEG0 ;FETCH SEGMENT RING
GO LONEHOLE ;AIN'T GOT NONE!!
FILOOP: RCOL 0,1 ;IS THIS SEGMENT RIGHT OF FISSION HOLE (SEG)
CAMG 0,R
GO [ CCW 1,1 ;NO, TRY NEXT ONE
AOS FS002 ;COUNT NUMBER OF SEARCHS
CAME 1,SEG0 ;IS THERE A NEXT ONE?
GO FILOOP ;YES, DO IT!
LONEHOLE: OUTSTR WARNMSG
AOS FS003
OUTSTR [ASCIZ/LONESOME HOLE (NOT INSIDE POLYGON) - MKSEGS
/]
BADHOLE: CALL(KLSEG,SEG) ;FLUSH THE LOSER
GO MKSEGS ] ;AND TRY NEXT PEAK
LCOL 0,1 ;IS FISSION HOLE WITHIN SEGMENT?
CAML 0,R
GO [ OUTSTR WARNMSG ;LOSER
AOS FS004
OUTSTR [ASCIZ/HOLE NOT WHOLY WITHIN SEGMENT - MKSEGS
/]↔ GO BADHOLE ]
LCOL. 0,SEG ;SWAP LEFT TERMINATORS
LCOL. L,1
FOR @' I ⊂ (LROW,LDEL,LT)
< I 0,1
I L,SEG
I'. 0,SEG
I'. L,1
>
LSEG. 1,L ;UPDATE THEIR TERMINATOR LINKS
MOVE L,0 ;0 CAN'T BE USED AS INDEX
LSEG. SEG,L
GO ADDSEG ;NOW ADD TO SEGMENT RING
DECLARE{LT001,LT002,LT003,LT004,RT001,RT002,RT003,EQ001}
DECLARE{FS001,FS002,FS003,FS004}
SUBREND MKSEGS
NSUBR FILL
;FILL BITS INTO PAK MATRIX.
ACCUMULATORS{R,C1,C2,BIT,SEG}
SKIPN SEG,SEG0↔POP0J
MOVE BIT,PAKBIT
MOVE R,ROW0↔LSH R,-6
SKIPL R ;OFF SCREEN TEST
CAILE R,=215
POP0J
CAMLE R,RMAX↔MOVEM R,RMAX
CAMGE R,RMIN↔MOVEM R,RMIN
LSH R,3
L1: LCOL C1,SEG
RCOL C2,SEG
L1A: ADDI C1,40↔LSH C1,-6
ADDI C2,40↔LSH C2,-6
SKIPGE C1↔SETZ C1,
SKIPGE C2↔SETZ C2,
CAILE C1,=287↔MOVEI C1,=287
CAILE C2,=287↔MOVEI C2,=287
CAMLE C1,CMAX↔MOVEM C1,CMAX↔CAMGE C1,CMIN↔MOVEM C1,CMIN
CAMLE C2,CMAX↔MOVEM C2,CMAX↔CAMGE C2,CMIN↔MOVEM C2,CMIN
CAMLE C1,C2↔GO [ FATAL(BACKWARD SEGMENT FOUND AT FILL!)]
L2: CAML C1,C2↔GO .+3
DPB BIT,PAKPTR(C1)↔AOJA C1,L2
CCW SEG,SEG
CAME SEG,SEG0↔GO L1
POP0J
SUBREND FILL;1/31/73(BGB)
NSUBR KLSEGS
;Advance each segment, checking to see if it has reached a
;terminator. If it has, look for next terminator and take
;appropriate action upon failure.
;
T1←2
SEG←10
SKIPN SEG,SEG0 ;GET SEGMENT LIST
GO [
ENDTST: SKIPN PEAK0 ;EMDPTY, ANY PEAKS LEFT
AOS (P) ;NO, SKIP RETURN MEANS WE'RE DONE
POP0J ]
SLOOP: FOR @' I ε {LR} ;FOR RIGHT AND LEFT DO:
< I'COL 0,SEG ;ADVANCE I COLUMN
I'DEL 1,SEG
ADD 0,1
I'T T1,SEG ;TEST FOR COLUMN OVERFLOW FROM ROUNDOFF
COL T1,T1
JUMPL 1,[ ;DIFFRENT FOR EACH DIRECTION
SOS T1 ;FUDGE FACTOR
CAMGE 0,T1 ;TOO FAR?
MOVE 0,T1 ;YES, USE TERMINATOR'S COLUMN
GO I'L1 ]
AOS T1 ;FUDGE FACTOR
CAMLE 0,T1 ;TOO FAR
MOVE 0,T1 ;YES, USE TERMINATOR'S COLUMN
I'L1: I'COL. 0,SEG
>
LROW 0,SEG ;HAS LEFT SEGMENT ENDED?
CAMLE 0,ROW0
GO DORIGHT ;(DUDDLY, OF COURSE)
CALL(LTXING,SEG)
GO [ SETQ SEG,{FUSION,1,SEG}
GO DORIGHT ]
GO [
DOKILL: CCW 1,SEG ;A SEGMENT DEATH
CAMN 1,SEG
SETZB 1,SEG0
EXCH 1,SEG
CAMN SEG,SEG0 ;IS THIS THE LAST SEGMENT IN RING?
GO [ CALL(KLSEG,1) ;YES, KILL AND RETURN
POP0J ]
CALL(KLSEG,1) ;NO, KILL
GO SLOOP ] ;AND DO NEXT SEGMENT
DORIGHT: RROW 0,SEG ;HAS LEFT SEGMENT ENDED?
CAMLE 0,ROW0
GO DONEXT ;NO, DO NEXT SEGMENT
CALL(RTXING,SEG)
GO [ CAMN 1,SEG0 ;SEGMENT HIT, DID IT WRAPAROUND?
OUTSTR[ASCIZ/WARNING - IMPOSSIBLE SEGMENT FUSION TYPE 2 - KLSEGS
/]
SETQ SEG,{FUSION,SEG,1} ;MAKE ONE FROM TWO
GO DORIGHT ] ;AND DON'T FORGET RIGHT PART OF SECOND SEG.
GO [ OUTSTR WARNMSG
OUTSTR [ASCIZ/UNEXPECTED SEGMENT DEATH - KLSEGS
/]↔ GO DOKILL ]
DONEXT: CCW SEG,SEG
CAME SEG,SEG0
GO SLOOP
POP0J
SUBREND KLSEGS
NSUBR LTXING,SEGMENT
;Search CCW for a vertex lower than ROW0 or the end of another
;segment. If the top of the polygon is found, then there is no
;terminator and the segment will die. If another segment is found,
;then the segment should be merged.
;
;No. of Skips Meaning
;0 Different segment found and returned in AC 1
;1 No terminator or segment found.
;2 Terminator found, segment updated.
;
ACCUMULATORS{R0,R1,V0,V1,SEG}
MOVE SEG,SEGMENT ;FETCH SEGMENT
LT V1,SEG ;AND OLD LEFT TERMINATOR
RSEG 1,V1 ;OTHER HALF EXIST?
JUMPN 1,[CAMN 1,SEG ;SAME AS SELF?
AOS (P) ;YES, NO, SEGMENT DEATH
POP1J] ;NO, RETURN, SEGMENT FUSION
SETZ 0, ;ZERO ITS LINK TO SEGMENT
LSEG. 0,V1
DPB 0,[POINT 1,2(V1),34];RESET RELOCATION
PGON 1,V1 ;GET TOP OF POLYGON
SON 1,1
MOVEM 1,VTOP#
VLOOP: MOVE V0,V1 ;ADVANCE TO NEXT VERTEX
CCW V1,V1
CAMN V1,VTOP ;AT TOP?
GO [ AOS (P) ;YES, SINGLE SKIP RETURN
POP1J ]
ROW R1,V1
CAMLE R1,ROW0 ;DOES IT CROSS ROW0?
GO FOUND ;YES
TESTZ V1,TMPBIT ;A SURIOUS PEAK?
GO [ CALL(KLPEAK,V1) ;YES, KILL IT
GO VLOOP ]
RSEG 1,V1 ;DID WE HIT A SEGMENT?
CAME 1,SEG ;AND IS IT A DIFFERENT SEGMENT? (MAYBE NOT FOR LTXING?)
JUMPN 1,POP1J. ;YES, RETURN
CAML R1,ROWM1 ;DOES IT CROSS PREVIOUS ROW0?
GO VLOOP ;NO, TRY NEXT VERTEX
AOS (P) ;YES, NO TERMINATOR
POP1J
FOUND: MOVEI 2 ;DOUBLE SKIP RETURN
ADDM (P)
ROW R0,V0
LSEG. SEG,V1
MOVEI 0,1 ;SET RELOCATION FOR SEGMENT
DPB 0,[POINT 1,2(V1),34];RESET RELOCATION
LT. V1,SEG ;LINK UP SEGMENT AND TERMINATOR
LROW. R1,SEG ;LAST ROW.
COL 0,V1 ;LDEL←(C1-C0)/(R1-R0).
COL 1,V0
SUB 0,1
ASH 0,6
SUB R1,R0
JUMPE R1,[FATAL(DIVISION BY ZERO AT LTXING)]
IDIV 0,R1
LDEL. 0,SEG
MOVE 1,ROW0 ;LCOL ← R0+LDEL*(ROW0-R0)
SUB 1,R0
IMUL 0,1
ASH 0,-6
COL 1,V0
ADD 0,1
LCOL. 0,SEG
POP1J
SUBREND LTXING
NSUBR RTXING,SEGMENT
;Search CW for a vertex lower than ROW0 or the end of another
;segment. If the top of the polygon is found, then there is no
;terminator and the segment will die. If another segment is found,
;then the segment should be merged.
;
;No. of Skips Meaning
;0 Different segment found and returned in AC 1
;1 No terminator or segment found.
;2 Terminator found, segment updated.
;
ACCUMULATORS{R0,R1,V0,V1,SEG}
MOVE SEG,SEGMENT ;FETCH SEGMENT
RT V1,SEG ;AND OLD LEFT TERMINATOR
LSEG 1,V1 ;OTHER HALF EXIST?
JUMPN 1,[CAMN 1,SEG ;SAME AS SELF?
AOS (P) ;YES, NO, SEGMENT DEATH
POP1J] ;NO, RETURN, SEGMENT FUSION
SETZ 0, ;ZERO ITS LINK TO SEGMENT
RSEG. 0,V1
DPB 0,[POINT 1,2(V1),35];RESET RELOCATION
PGON 1,V1 ;GET TOP OF POLYGON
SON 1,1
MOVEM 1,VTOP#
VLOOP: MOVE V0,V1 ;ADVANCE TO NEXT VERTEX
CW V1,V1
CAMN V1,VTOP ;AT TOP?
GO [ AOS (P) ;YES, SINGLE SKIP RETURN
POP1J ]
ROW R1,V1
CAMLE R1,ROW0 ;DOES IT CROSS ROW0?
GO FOUND ;YES
TESTZ V1,TMPBIT ;A SURIOUS PEAK?
GO [ CALL(KLPEAK,V1) ;YES, KILL IT
GO VLOOP ]
LSEG 1,V1 ;DID WE HIT A SEGMENT?
CAME 1,SEG ;AND IS IT A DIFFERENT SEGMENT? (MAYBE NOT FOR LTXING?)
JUMPN 1,POP1J. ;YES, RETURN
CAML R1,ROWM1 ;DOES IT CROSS PREVIOUS ROW0?
GO VLOOP ;NO, TRY NEXT
AOS (P) ;YES, NO TERMINATOR
POP1J
FOUND: MOVEI 2 ;DOUBLE SKIP RETURN
ADDM (P)
ROW R0,V0
RSEG. SEG,V1
MOVEI 0,1 ;SET RELOCATION FOR SEGMENT
DPB 0,[POINT 1,2(V1),35];RESET RELOCATION
RT. V1,SEG ;LINK UP SEGMENT AND TERMINATOR
RROW. R1,SEG ;LAST ROW.
COL 0,V1 ;RDEL←(C1-C0)/(R1-R0).
COL 1,V0
SUB 0,1
ASH 0,6
SUB R1,R0
JUMPE R1,[FATAL(DIVISION BY ZERO AT RTXING)]
IDIV 0,R1
RDEL. 0,SEG
MOVE 1,ROW0 ;RCOL ← R0+RDEL*(ROW0-R0)
SUB 1,R0
IMUL 0,1
ASH 0,-6
COL 1,V0
ADD 0,1
RCOL. 0,SEG
POP1J
SUBREND RTXING
NSUBR KLSEG,SEG
;KILL SEGMENT - AC TRANSPARENT (EXCEPT FOR 0,1)
PUSHP 2
PUSHP 3
MOVE 3,SEG
RELOC 0,3
CAIE 0,300003
GO [ FATAL(KLSEG CALLED WITH NON-SEGMENT) ]
;CLEAN UP ARC LINKS.
; SETZ↔LT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
; SETZ↔RT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
SETZ↔LT 1,3↔LSEG 2,1↔CAMN 2,3↔LSEG. 0,1
DPB 0,[POINT 2,2(1),35] ;RESET RELOCATION
RT 1,3↔RSEG 2,1↔CAMN 2,3↔RSEG. 0,1
DPB 0,[POINT 2,2(1),35] ;RESET RELOCATION
;RING OUT AND KILL THE SEGMENT.
CW 1,3↔CCW 2,3
CCW. 2,1↔CW. 1,2
CAMN 1,3↔SETZ 2,
CAMN 3,SEG0
MOVEM 2,SEG0
CALL(KILL,3)
POPP 3
POPP 2
POP1J
SUBREND;1/31/73(BGB)
NSUBR KLPEAK,PEAK
;KILL PEAK VERTEX - AC TRANSPARENT (EXCEPT FOR 0,1)
PUSHP 2
PUSHP 3
MOVE 3,PEAK↔MARKZ 3,TMPBIT
SETZ 1,↔DPB 1,[POINT 2,2(3),35] ;RESET RELOCATION
HLRZ 1,6(3)↔HRRZ 2,6(3)
HRRM 2,6(1)↔HRLM 1,6(2)
SETZM 6(3)
CAMN 2,3↔SETZ 2,
CAMN 3,PEAK0↔MOVEM 2,PEAK0
POPP 3
POPP 2
POP1J
SUBREND;1/31/73(BGB)
NSUBR FUSION,SEG1,SEG2
ACCUMULATORS{T1,S1,S2}
MOVE S1,SEG1
MOVE S2,SEG2
LT 1,S1 ;SWAP RIGHT TERMINATORS
LT 2,S2
LT. 2,S1
LSEG. S1,2
LT. 1,S2
LSEG. S2,1
DPB 0,[POINT 1,2(1),35]
FOR @' I ⊂ (LROW,LCOL,LDEL)
< I 0,S1
I'. 0,S2
>
SKIPN (S1) ;IS SEG1 IN RING
GO [ CALL(KILL,S1) ;EASY OUT
MOVE 1,S2
POP2J ]
SKIPE 1,(S2)
GO [ CALL(KLSEG,S1)
MOVE 1,S2
POP2J ]
MOVE (S1)
MOVEM (S2)
CW 1,S2
CCW. S2,1
CCW 1,S2
CW. S2,1
CALL(KILL,S1)
POP2J
SUBREND FUSION
;SUBRS ZAPTIM,CLRPAK,REVHOL,RSTHOL
;_________________________________________________________________
NSUBR ZAPTIM,LVL
ACCUMULATORS{V,V0,PGN,PGN0}
MOVE 1,LVL
SON PGN,1
MOVEM PGN,PGN0
SETZ 0,
PLOOP: SON V,PGN
MOVE V0,V
VLOOP: SETZM 6(V)
CCW V,V
CAME V,V0
GO VLOOP
CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
POP1J
SUBREND ZAPTIM;10-APR-73
;_________________________________________________________________
NSUBR CLRPAK
SETZM PAK↔MOVE[XWD PAK,PAK+1]↔BLT PAK+=1727
SETZM CMAX↔SETZM RMAX
MOVEI =288↔MOVEM CMIN
MOVEI =216↔MOVEM RMIN
POP0J
SUBREND CLRPAK;30-MAR-73(TVR)
;_________________________________________________________________
NSUBR REVHOL,LVL
ACCUMULATORS{V,V0,PGN,PGN0}
MOVE 1,LVL
SON PGN,1
JUMPE PGN,POP1J.
MOVEM PGN,PGN0
PLOOP: TESTZ PGN,HOLBIT+REVBIT
GO PCONT
MARK PGN,REVBIT
SON V,PGN
MOVE V0,V
VLOOP: MOVSS (V)
CW V,V
CAME V,V0
GO VLOOP
PCONT: CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
POP1J
SUBREND REVHOL;10-APR-73
;_________________________________________________________________
NSUBR RSTHOL,LVL
ACCUMULATORS{V,V0,PGN,PGN0}
MOVE 1,LVL
SON PGN,1
JUMPE PGN,POP1J.
MOVEM PGN,PGN0
PLOOP: TEST PGN,REVBIT
GO PCONT
MARKZ PGN,REVBIT
SON V,PGN
MOVE V0,V
VLOOP: MOVSS (V)
CW V,V
CAME V,V0
GO VLOOP
PCONT: CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
POP1J
SUBREND RSTHOL;10-APR-73
;SUBRS CENPIC,RECPIC
;_________________________________________________________________
NSUBR CENPIC,LVL
SKIPN CNTFLG
POP1J
CALL(LIMITS,LVL)
MOVE 5,[XWD -4,1]↔MOVEI 0,77
SETCMI 6,37
L0: ANDM 0,(5)↔TDNE 6,(5)
ORM 6,(5)↔AOBJN 5,L0
ADD 1,2↔ADD 3,4↔ ;AVERAGE THEM
ASH 1,-1↔ASH 3,-1
ADDI 1,40↔ADDI 3,40
MOVEM 1,DELX↔MOVEM 3,DELY ;REMEMBER OFFSET
MOVN 1,1↔MOVN 3,3 ;CENTER IT WITH RESPECT TO GRID
CALL(XYMOVE,LVL,1,3) ;DO ACTUAL MOVING
POP1J
SUBREND CENPIC
;_________________________________________________________________
NSUBR RECPIC,LVL
SKIPN CNTFLG
POP1J
CALL(XYMOVE,LVL,DELX,DELY)
POP1J
SUBREND RECPIC
;_________________________________________________________________
DELX: 0
DELY: 0
END